home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / TSR.SWG / 0012_TSR in DPMI Mode.pas < prev    next >
Pascal/Delphi Source File  |  1993-11-02  |  11KB  |  226 lines
  1. {
  2. CEES BINKHORST
  3.  
  4. > I have a Turbo Pascal program running in DPMI mode that needs to
  5. > interface to a real mode TSR program.  The TSR program issues
  6. > INT$61 when it has data that needs to be serviced.  I've installed
  7. > an interupt service routine that works ok in real mode, but not DPMI.
  8.  
  9. Have a look at the following. With some amendments it will do what you want.
  10.  
  11. ;from c't 1/1992 #196
  12. .286p                  ;generate protected mode code for 286 or higher
  13.  
  14. dpmitsr segment public ;dpmitsr: name of program
  15.                        ;segment: indicates start of programcode for
  16.                        ; 'dpmitsr'. see also end of code: 'dpmitsr ends'
  17.                        ;public (without addition (name)): instruction
  18.                        ; for linker to put all of it in one segment
  19.      assume cs:dpmitsr, ds:dpmitsr ;as soon as program starts 'cs' and
  20.                                    ; 'ds' cpu-registers (code and data segment
  21.                                    ; segment registers) are filled with memory
  22.                                    ; position of start of program 'dpmitsr'
  23.                                    ;there are no seperate code en data
  24.                                    ; segments
  25. olduserint     label word       ;
  26.                dw    ?, ?
  27. readmessage    db 'This text is in TSR and is be shown through a pointer.', 0
  28. writemessage   db 'This text is copied from TSR', 0
  29. writedata      equ $-offset writemessage ;calculate length 'writemessage' and
  30.                                          ; use value later in program
  31. ;--------- procedure 'userint' is comparable with a pascal instruction if:
  32. ; case ah of 0: execute instruction 'message'
  33. ;            1: excute instruction 'read'
  34. ;            2: excute instruction 'write'
  35. userint     proc far ;new int 61h
  36.                      ;userint: name has only measning within thsi text for
  37.                      ; compiler - see also end 'userint endp'
  38.                      ;proc far: instruktion for compiler to generate code
  39.                      ; to push a segment:offset return address on the stack
  40.                      ; (near proc pushes only offset)
  41.                      ; this procedure is called from another
  42.                      ; code segment (dos through int. in dpmiwin!)
  43.             pushf    ;save flags
  44.             cmp ah, 00h ;message instruction - see dpmiwin dcs.eax:=$00000000
  45.             je  message
  46.             cmp ah, 01h ;read instruction = dpmiwin dcs.eax:=$00000100
  47.             je  read
  48.             cmp ah, 02h ;write instruction = dpmiwin dcs.eax:=$00000200
  49.             je  write
  50.             popf        ;put flags back if ah is not 00, 01 or 02 in ah and
  51.             jmp dword ptr cs:[olduserint]  ; continue with old interrupt
  52. ;---------- procedure 'message'
  53. message:    mov ax,0affeh     ;affe hex is in-memory mark of this program
  54.             popf              ;put flags back
  55.             iret              ;interrupt ends here and has only put
  56.                               ; affe hex in cpu register ax
  57.                               ;program dpmiwin will see it there and know then
  58.                               ; that 'dpmitsr' is loaded in memory
  59. ;---------- procedure 'read'
  60. read:       mov ax, seg dpmitsr  ;make registers es:di together pint to
  61.             mov es, ax           ; string readmessage. this will then be used
  62.                                  ; by 'dpmiwin' to put it on the screen
  63.             mov di, offset readmessage
  64.             popf              ;put flags back
  65.             iret              ;interrupt ends now here
  66. ;---------- procedure 'write'
  67. write:      push cx           ;save registers
  68.             push si
  69.             push ds
  70.             cld               ;direction flag = 0
  71.             mov cx, seg dpmitsr
  72.             mov ds, cx        ;make ds:si point to string writemessage
  73.             mov cx, writedata ;get calculated length of string writemessage
  74.             mov si, offset writemessage
  75.             rep movsb         ; and copy string from ds:si to es:di.
  76.                               ; es:di are put in dpmicallstruc by dpmiwin
  77.             pop ds            ;put registers back
  78.             pop si
  79.             pop cx
  80.             popf              ;put flags back
  81.             iret              ;interrupt now ends here
  82. userint     endp              ;end of code for procedure 'userint'
  83.                               ; van gehele echte interrupt dus
  84. ;---------- this code does not remain in memory
  85. install:    mov ax, seg dpmitsr   ;make ds:dx point to string hello$
  86.             mov ds, ax
  87.             mov dx, offset hello$ ;offset of message that it is installed
  88.                                   ; as a memory-resident program
  89.             mov ah, 09h           ;send string hello$ to (dos) screen
  90.             int 21h               ; to signal installation of 'dpmitsr'
  91.             mov ax, 03561h        ;what is old address of int. 61h
  92.             int 21h
  93.             mov [olduserint], bx  ; and save it in two steps
  94.             mov [olduserint+2], es ;
  95.             mov ax, 2561h         ;subfunction 25 of int. 21: pu new address
  96.             mov dx, offset userint; int. 61h (procedure 'userint') in memory
  97.             int 21h
  98.             mov dx, offset install ;how many bytes (convert to paragraphs by:
  99. shr 4)
  100.             shr dx, 4              ;  of program have to
  101.             add dx, 011h           ;  remain in memory
  102.             mov ax, 03100h         ;subfunction 31 of int. 21 with 'return
  103. code' 0
  104.             int 21h                ;makes part of program resident
  105. hello$      db  13,10,'DPMITSR-example installed.',13,10,'$'
  106. dpmitsr     ends
  107.             end install            ;end of installation procedure
  108.  
  109. }
  110. program dpmiwin;               {from c't 1/1992 # 197}
  111.  
  112. uses
  113.   winprocs,
  114.   wintypes,
  115.   win31,
  116.   wincrt;
  117.  
  118. type
  119.   tDPMICallStruc = Record  {for use by RMInterrupt}
  120.     EDI, ESI, EBP, Reserved,
  121.     EBX, EDX, ECX, EAX : longint;
  122.     Flags, ES, DS, FS,
  123.     GS, IP, CS, SP, SS : word;
  124.   end;
  125.  
  126. function RMInterrupt(IntNo, flags, copywords : byte;
  127.                      var DPMICallStruc : tDPMICallStruc) : boolean;
  128. begin
  129.   asm
  130.     push es       {save es en di from protected mode on stack}
  131.     push di
  132.     mov bh, flags {if bit 0 is zero interrupt controller ...}
  133.                   {... and A20-line will be reset. other bits must be zero}
  134.     mov bl, intno {put interrupt nummer to be executed in register bl}
  135.     mov cx, word ptr copywords {cx = number of words that are to be copied...}
  136.                   { from... prot. mode to real mode stack}
  137.     mov ax, 0300h {put DPMI simulate real mode interrupt nummer in register ax}
  138.     les di, dpmiCallStruc  {16-bits pointer to record - 32 bits uses edi}
  139.                   {les di, ...: load segment (2 bytes) dpmicallstruc in}
  140.                   { register di en offset (ook 2 bytes) }
  141.                   { in register es. in short load pointer to dpmicallstruc}
  142.                   { in registers di:es                                 }
  143.     int 31h       {excute interrupt nummer in bl in real-mode after filling }
  144.            { cpu-registers with values from dpmicallstruc and return in}
  145.            { protected mode with contents of cpu-registers at end of real-mode}
  146.            { interrupt in dpmicallstruc. i.o.w. act as if dpmicallstruc  }
  147.            { are the cpu-registers at the end of excuting the real-mode int.}
  148.     jc @error
  149.     mov ax, 1           {function succesfull}
  150.     jmp @done
  151.    @error:
  152.     xor ax, ax          {make ax=0, function not succesfull}
  153.    @done:
  154.     pop di              {put es and di back}
  155.     pop es
  156.   end;
  157. end;
  158.  
  159. var
  160.   selector  : word;
  161.   segment   : word;
  162.   selseg    : longint;
  163.   dcs       : tdpmicallstruc;
  164.   printstrg : pchar;
  165.  
  166. begin
  167.   fillchar(dcs, sizeof(dcs), 0);    {zero dcs}
  168.     {------- verify presence of dpmitsr in memory}
  169.   dcs.eax := $00000000;  {just for clarity that ax is called with function 0}
  170.                          { as contents is already zero because of use}
  171.                          { of function filchar() on previous line. }
  172.   rminterrupt($61, 0, 0, dcs);
  173.   if (dcs.eax and $ffff = $affe) then
  174.     writeln('DPMItsr in memory')
  175.    else
  176.      writeln('Something went wrong!');
  177.              {this part needs improvement.                 }
  178.              {if dpmitsr is not in memory then pc may crash,}
  179.              { which is not strange as then an interrupt  }
  180.              { is called that most likely is 0000:0000 in        }
  181.              { memory.                                        }
  182.              {this is to be substituted with a routine that first checks}
  183.              { that pointer of int. 61 is not 0000:0000.        }
  184.     {------- read string through pointer}
  185.   dcs.eax := $00000100;              {call int. 61 (=dpmitsr) with ah = 1}
  186.   rminterrupt($61, 0, 0, dcs);
  187.   selector := allocselector(word(nil)); {make new selector and fill with values:}
  188.   setselectorbase(selector, longint(dcs.es) * 16);
  189.                                       { base: es is put in by 'dpmitsr'}
  190.   setselectorlimit(selector, longint($ffff));
  191.                                      { and limit: $ffff is maximum value. this}
  192.                                      { does not give problems because we put a}
  193.                                      { 'zero-terminated' string on the screen.}
  194.   printstrg := ptr(selector, word(dcs.edi));   {also di is put in by 'dpmitsr'  }
  195.   writeln(printstrg);
  196.   freeselector(selector);
  197.     {------- read string by making a copy from real-mode memory to
  198.               Windows-memory in low 640k-area}
  199.   selseg := globaldosalloc(100); {allocate 100 bytes Windows-memory below 640k.}
  200.                                {high word of longint 'selseg' is segment for }
  201.                                { use in real-mode and low word is selector    }
  202.                                { for use in protected mode.                 }
  203.   if selseg <> 0 then
  204.   begin
  205.     selector := word(selseg and $ffff);  {determine selector}
  206.     segment  := word(selseg shr 16);      {determine segment}
  207.     dcs.eax  := $00000200;               {call int. 61 (=dpmitsr) with ah = 2   }
  208.     dcs.es   := segment;                   {use segment for int. 61 in real-mode}
  209.     dcs.edi  := 0;                       {offset is 0                          }
  210.     rminterrupt($61, 0, 0, dcs);
  211.     printstrg := ptr(selector, 0);
  212.     writeln(printstrg);
  213.     globaldosfree(selector);
  214.   end;
  215. end.
  216.  
  217. {
  218. To excute the program, dpmitsr.exe has to be executed before starting Windows.
  219. Dpmitsr will remain permanently in memory.
  220.  
  221. Both DPMITSR.ASM and DPMIWIN.PAS were nicely running programs in early 1992
  222. with TPW. Now, under BPW an error is reported from the SYSTEM unit.
  223. However, as I now don't have the time to trace the error herewith the programs,
  224. as it will surely point the way for you to go.
  225. }
  226.